home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / setplt.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-22  |  10.4 KB  |  346 lines
  1. /* setplt.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  26.         sfactr;
  27.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  28.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  29. } status_;
  30.  
  31. #define status_1 status_
  32.  
  33. struct {
  34.     doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas, 
  35.         rstats[50];
  36.     integer iwidth, lwidth, nopage;
  37. } miscel_;
  38.  
  39. #define miscel_1 miscel_
  40.  
  41. struct {
  42.     doublereal tcstar[2], tcstop[2], tcincr[2];
  43.     integer icvflg, itcelm[2], kssop, kinel, kidin, kovar, kidout;
  44. } dc_;
  45.  
  46. #define dc_1 dc_
  47.  
  48. struct {
  49.     doublereal fstart, fstop, fincr, skw2, refprl, spw2;
  50.     integer jacflg, idfreq, inoise, nosprt, nosout, nosin, idist, idprt;
  51. } ac_;
  52.  
  53. #define ac_1 ac_
  54.  
  55. struct {
  56.     doublereal tstep, tstop, tstart, delmax, tdmax, forfre;
  57.     integer jtrflg;
  58. } tran_;
  59.  
  60. #define tran_1 tran_
  61.  
  62. struct {
  63.     doublereal xincr, string[15], xstart, yvar[8];
  64.     integer itab[8], itype[8], ilogy[8], npoint, numout, kntr, numdgt;
  65. } outinf_;
  66.  
  67. #define outinf_1 outinf_
  68.  
  69. struct {
  70.     doublereal value[200000];
  71. } blank_;
  72.  
  73. #define blank_1 blank_
  74.  
  75. /* Table of constant values */
  76.  
  77. static integer c__1 = 1;
  78. static integer c__7 = 7;
  79.  
  80. /*<       subroutine setplt(loc) >*/
  81. /* Subroutine */ int setplt_(loc)
  82. integer *loc;
  83. {
  84.     /* Initialized data */
  85.  
  86.     static integer logopt[6] = { 2,2,1,1,1,1 };
  87.     static struct {
  88.     char e_1[8];
  89.     doublereal e_2;
  90.     } equiv_21 = { {' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  91.  
  92. #define ablnk (*(doublereal *)&equiv_21)
  93.  
  94.     static struct {
  95.     char e_1[8];
  96.     doublereal e_2;
  97.     } equiv_22 = { {' ', ' ', 't', 'i', 'm', 'e', ' ', ' '}, 0. };
  98.  
  99. #define atimex (*(doublereal *)&equiv_22)
  100.  
  101.     static struct {
  102.     char e_1[8];
  103.     doublereal e_2;
  104.     } equiv_23 = { {' ', ' ', 'f', 'r', 'e', 'q', ' ', ' '}, 0. };
  105.  
  106. #define afreq (*(doublereal *)&equiv_23)
  107.  
  108.     static struct {
  109.     char e_1[8];
  110.     doublereal e_2;
  111.     } equiv_24 = { {'*', '+', '=', '$', '0', '<', '>', '?'}, 0. };
  112.  
  113. #define pltsym (*(doublereal *)&equiv_24)
  114.  
  115.  
  116.     /* Format strings */
  117.     static char fmt_41[] = "(\0020legend:\002/)";
  118.     static char fmt_61[] = "(1x,a1,\002: \002,5a8)";
  119.     static char fmt_101[] = "(\002x\002/3x,a8,4x,5a8)";
  120.  
  121.     /* System generated locals */
  122.     integer i_1, i_2;
  123.  
  124.     /* Builtin functions */
  125.     integer s_wsfe(), e_wsfe(), do_fio();
  126.  
  127.     /* Local variables */
  128.     static integer loce, loct;
  129.     extern /* Subroutine */ int move_();
  130.     static integer ipos, i, j;
  131.     static doublereal achar;
  132.     static integer itemp, jstop;
  133. #define nodplc ((integer *)&blank_1)
  134. #define cvalue ((complex *)&blank_1)
  135.     static doublereal asweep;
  136.     static integer ioutyp;
  137.     extern /* Subroutine */ int outnam_();
  138.  
  139.     /* Fortran I/O blocks */
  140.     static cilist io__12 = { 0, 0, 0, fmt_41, 0 };
  141.     static cilist io__18 = { 0, 0, 0, fmt_61, 0 };
  142.     static cilist io__20 = { 0, 0, 0, fmt_101, 0 };
  143.  
  144.  
  145. /*<       implicit double precision (a-h,o-z) >*/
  146.  
  147. /*     this routine generates the 'legend' subheading used to identify */
  148. /* individual traces on multi-trace line-printer plots. */
  149.  
  150. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  151. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  152. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  153. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  154. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  155. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  156. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  157. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  158. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  159. /* spice version 2g.6  sccsid=status 3/15/83 */
  160. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  161. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  162. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  163. /* spice version 2g.6  sccsid=miscel 3/15/83 */
  164. /*<       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
  165. /*<      1  defas,rstats(50),iwidth,lwidth,nopage >*/
  166. /* spice version 2g.6  sccsid=dc 3/15/83 */
  167. /*<       common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop, >*/
  168. /*<      1   kinel,kidin,kovar,kidout >*/
  169. /* spice version 2g.6  sccsid=ac 3/15/83 */
  170. /*<       common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq, >*/
  171. /*<      1   inoise,nosprt,nosout,nosin,idist,idprt >*/
  172. /* spice version 2g.6  sccsid=tran 3/15/83 */
  173. /*<       common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg >*/
  174. /* spice version 2g.6  sccsid=outinf 3/15/83 */
  175. /*<       common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8), >*/
  176. /*<      1   ilogy(8),npoint,numout,kntr,numdgt >*/
  177. /* spice version 2g.6  sccsid=blank 3/15/83 */
  178. /*<       common /blank/ value(200000) >*/
  179. /*<       integer nodplc(64) >*/
  180. /*<       complex cvalue(32) >*/
  181. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  182.  
  183. /*<       dimension logopt(6) >*/
  184. /*<       data logopt / 2, 2, 1, 1, 1, 1 / >*/
  185. /*<       data ablnk, atimex, afreq / 1h , 6h  time, 6h  freq / >*/
  186. /*<       data pltsym / 8h*+=$0<>? / >*/
  187.  
  188. /*  set limits depending upon the analysis mode */
  189.  
  190. /*<       if (mode-2) 10,20,30 >*/
  191.     if ((i_1 = status_1.mode - 2) < 0) {
  192.     goto L10;
  193.     } else if (i_1 == 0) {
  194.     goto L20;
  195.     } else {
  196.     goto L30;
  197.     }
  198. /*<    10 xstart=tcstar(1) >*/
  199. L10:
  200.     outinf_1.xstart = dc_1.tcstar[0];
  201. /*<       xincr=tcincr(1) >*/
  202.     outinf_1.xincr = dc_1.tcincr[0];
  203. /*<       npoint=icvflg >*/
  204.     outinf_1.npoint = dc_1.icvflg;
  205. /*<       itemp=itcelm(1) >*/
  206.     itemp = dc_1.itcelm[0];
  207. /*<       loce=nodplc(itemp+1) >*/
  208.     loce = nodplc[itemp];
  209. /*<       asweep=value(loce) >*/
  210.     asweep = blank_1.value[loce - 1];
  211. /*<       go to 40 >*/
  212.     goto L40;
  213. /*<    20 xstart=tstart >*/
  214. L20:
  215.     outinf_1.xstart = tran_1.tstart;
  216. /*<       xincr=tstep >*/
  217.     outinf_1.xincr = tran_1.tstep;
  218. /*<       npoint=jtrflg >*/
  219.     outinf_1.npoint = tran_1.jtrflg;
  220. /*<       asweep=atimex >*/
  221.     asweep = atimex;
  222. /*<       go to 40 >*/
  223.     goto L40;
  224. /*<    30 xstart=fstart >*/
  225. L30:
  226.     outinf_1.xstart = ac_1.fstart;
  227. /*<       xincr=fincr >*/
  228.     outinf_1.xincr = ac_1.fincr;
  229. /*<       npoint=icalc >*/
  230.     outinf_1.npoint = status_1.icalc;
  231. /*<       asweep=afreq >*/
  232.     asweep = afreq;
  233.  
  234. /*  construct and print the output variables with corresponding plot */
  235. /*    symbols */
  236.  
  237. /*<    40 loct=loc+2 >*/
  238. L40:
  239.     loct = *loc + 2;
  240. /*<       if (kntr.eq.1) go to 80 >*/
  241.     if (outinf_1.kntr == 1) {
  242.     goto L80;
  243.     }
  244. /*<       write (iofile,41) >*/
  245.     io__12.ciunit = status_1.iofile;
  246.     s_wsfe(&io__12);
  247.     e_wsfe();
  248. /*<    41 format('0legend:'/) >*/
  249. /*<       do 70 i=1,kntr >*/
  250.     i_1 = outinf_1.kntr;
  251.     for (i = 1; i <= i_1; ++i) {
  252. /*<       loct=loct+2 >*/
  253.     loct += 2;
  254. /*<       itab(i)=nodplc(loct) >*/
  255.     outinf_1.itab[i - 1] = nodplc[loct - 1];
  256. /*<       ioutyp=nodplc(loct+1) >*/
  257.     ioutyp = nodplc[loct];
  258. /*<       itype(i)=ioutyp >*/
  259.     outinf_1.itype[i - 1] = ioutyp;
  260. /*<       ilogy(i)=1 >*/
  261.     outinf_1.ilogy[i - 1] = 1;
  262. /*<       if (mode.le.2) go to 50 >*/
  263.     if (status_1.mode <= 2) {
  264.         goto L50;
  265.     }
  266. /*<       ilogy(i)=logopt(ioutyp) >*/
  267.     outinf_1.ilogy[i - 1] = logopt[ioutyp - 1];
  268. /*<    50 ipos=1 >*/
  269. L50:
  270.     ipos = 1;
  271. /*<       call outnam(itab(i),itype(i),string,ipos) >*/
  272.     outnam_(&outinf_1.itab[i - 1], &outinf_1.itype[i - 1], 
  273.         outinf_1.string, &ipos);
  274. /*<       call move(string,ipos,ablnk,1,7) >*/
  275.     move_(outinf_1.string, &ipos, &ablnk, &c__1, &c__7);
  276. /*<       jstop=(ipos+6)/8 >*/
  277.     jstop = (ipos + 6) / 8;
  278. /*<       call move(achar,1,pltsym,i,1) >*/
  279.     move_(&achar, &c__1, &pltsym, &i, &c__1);
  280. /*<       write (iofile,61) achar,(string(j),j=1,jstop) >*/
  281.     io__18.ciunit = status_1.iofile;
  282.     s_wsfe(&io__18);
  283.     do_fio(&c__1, (char *)&achar, (ftnlen)sizeof(doublereal));
  284.     i_2 = jstop;
  285.     for (j = 1; j <= i_2; ++j) {
  286.         do_fio(&c__1, (char *)&outinf_1.string[j - 1], (ftnlen)sizeof(
  287.             doublereal));
  288.     }
  289.     e_wsfe();
  290. /*<    61 format(1x,a1,2h: ,5a8) >*/
  291. /*<    70 continue >*/
  292. /* L70: */
  293.     }
  294. /*<    80 if (kntr.ge.2) go to 90 >*/
  295. L80:
  296.     if (outinf_1.kntr >= 2) {
  297.     goto L90;
  298.     }
  299. /*<       itab(1)=nodplc(loc+4) >*/
  300.     outinf_1.itab[0] = nodplc[*loc + 3];
  301. /*<       ioutyp=nodplc(loc+5) >*/
  302.     ioutyp = nodplc[*loc + 4];
  303. /*<       itype(1)=ioutyp >*/
  304.     outinf_1.itype[0] = ioutyp;
  305. /*<       ilogy(1)=1 >*/
  306.     outinf_1.ilogy[0] = 1;
  307. /*<       if (mode.le.2) go to 90 >*/
  308.     if (status_1.mode <= 2) {
  309.     goto L90;
  310.     }
  311. /*<       ilogy(1)=logopt(ioutyp) >*/
  312.     outinf_1.ilogy[0] = logopt[ioutyp - 1];
  313. /*<    90 ipos=1 >*/
  314. L90:
  315.     ipos = 1;
  316. /*<       call outnam(itab(1),itype(1),string,ipos) >*/
  317.     outnam_(outinf_1.itab, outinf_1.itype, outinf_1.string, &ipos);
  318. /*<       call move(string,ipos,ablnk,1,7) >*/
  319.     move_(outinf_1.string, &ipos, &ablnk, &c__1, &c__7);
  320. /*<       jstop=(ipos+6)/8 >*/
  321.     jstop = (ipos + 6) / 8;
  322. /*<       write (iofile,101) asweep,(string(j),j=1,jstop) >*/
  323.     io__20.ciunit = status_1.iofile;
  324.     s_wsfe(&io__20);
  325.     do_fio(&c__1, (char *)&asweep, (ftnlen)sizeof(doublereal));
  326.     i_1 = jstop;
  327.     for (j = 1; j <= i_1; ++j) {
  328.     do_fio(&c__1, (char *)&outinf_1.string[j - 1], (ftnlen)sizeof(
  329.         doublereal));
  330.     }
  331.     e_wsfe();
  332. /*<   101 format(1hx/3x,a8,4x,5a8) >*/
  333. /*<       return >*/
  334.     return 0;
  335. /*<       end >*/
  336. } /* setplt_ */
  337.  
  338. #undef cvalue
  339. #undef nodplc
  340. #undef pltsym
  341. #undef afreq
  342. #undef atimex
  343. #undef ablnk
  344.  
  345.  
  346.